home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEM / VDIINQUI.I < prev    next >
Encoding:
Modula Implementation  |  1993-10-29  |  12.5 KB  |  422 lines

  1. IMPLEMENTATION MODULE VDIInquires;
  2. (*$L-, Y+*)
  3.  
  4.  
  5. (*  MEGAMAX MODULA 2 GEM-Library :  Die VDI Nachfragefunktionen
  6.  *
  7.  *  Autor: Manuel Chakravarty           Erstellt :  04.11.87
  8.  *
  9.  *  Version   2.2     V#0031
  10.  *)
  11.  
  12. (*  18.08.89 MCH V0.11  | 'GetLineStyle' um die Linienenden erweitert
  13.  *  ???????? TT  V2.1   | REF-Parm.
  14.  *  02.04.90 MCH V2.2   | Anpassung an public arrays
  15.  *  25.02.91 TT           "error"-Setzung über occured-Funktion
  16.  *  17.04.91 TT         | 'GetLineStyle' korrigiert: 'handle' wurde falsch
  17.  *                        ermittelt - führte zu Laufzeitfehler
  18.  *  28.04.91 TT         | 'GetLineStyle' korrigiert (Parms stimmten nicht)
  19.  *                        und getestet.
  20.  *)
  21.  
  22.  
  23. FROM    SYSTEM          IMPORT ASSEMBLER;
  24.  
  25. FROM    MOSGlobals      IMPORT StringOverflow;
  26.  
  27. FROM    GrafBase        IMPORT Rectangle, WritingMode;
  28.  
  29. FROM    GEMGlobals      IMPORT LineType, MarkerType, FillType, THorJust,
  30.                                TVertJust, LineEnding;
  31.                    
  32. IMPORT  GEMShare;
  33.  
  34. FROM    GEMEnv          IMPORT DeviceHandle;
  35.  
  36. (*$I GEMOPS.ICL *)
  37.  
  38.  
  39. PROCEDURE GetColorDef(handle:DeviceHandle;color:CARDINAL;set:BOOLEAN;
  40.                       VAR r,g,b:CARDINAL);
  41.  
  42. BEGIN
  43.   ASSEMBLER
  44.     MOVE.L      -(A3),-(A7)
  45.     MOVE.L      -(A3),-(A7)
  46.     MOVE.L      -(A3),-(A7)
  47.     MOVE.L      pubs,A0
  48.     MOVE.L      -(A3),pubArrays.vINTIN(A0)
  49.     MOVE.W      #INQUIRE_COLOR,(A3)+
  50.     CLR.W       (A3)+
  51.     JSR         vdi_if
  52.     MOVE.L      pubs,A0
  53.     TST.W       pubArrays.vINTOUT(A0)
  54.     BPL         noErr
  55.     JSR         gemErrorOccured
  56.     ADDA.W      #12,A7
  57.     BRA         cont
  58. noErr
  59.     MOVE.L      (A7)+,A1
  60.     MOVE.W      pubArrays.vINTOUT+2(A0),(A1)
  61.     MOVE.L      (A7)+,A1
  62.     MOVE.W      pubArrays.vINTOUT+4(A0),(A1)
  63.     MOVE.L      (A7)+,A1
  64.     MOVE.W      pubArrays.vINTOUT+6(A0),(A1)
  65. cont
  66.   END;
  67. END GetColorDef;
  68.  
  69. PROCEDURE GetLineStyle(    handle: DeviceHandle;
  70.                        VAR typ   : LineType;
  71.                        VAR color : CARDINAL;
  72.                        VAR mode  : WritingMode;
  73.                        VAR begin,
  74.                            end   : LineEnding;
  75.                        VAR width : CARDINAL    );
  76.                        
  77. BEGIN
  78.   ASSEMBLER
  79.         MOVE.L  -28(A3),(A3)+           ; handle
  80.         MOVE.W  #INQUIRE_LINE,(A3)+
  81.         CLR.W   (A3)+
  82.         JSR     vdi_if
  83.         MOVE.L  pubs,A0
  84.         MOVE.L  -(A3),A1
  85.         MOVE.W  pubArrays.PTSOUT(A0),(A1)      ; 'width' = ptsout[0]
  86.         
  87.         LEA     pubArrays.vINTOUT(A0),A0
  88.         
  89.         MOVE.L  our_cb,A1
  90.         CMPI.W  #3,cb.V_CONTRL.sintout(A1)
  91.         BLS     noBegEnd
  92.         
  93.         MOVE.L  -(A3),A1
  94.         MOVE.W  2*4(A0),D0
  95.         SUBQ.W  #1,D0
  96.         MOVE.W  D0,(A1)                 ; 'end' = vINTOUT[4]
  97.         
  98.         MOVE.L  -(A3),A1
  99.         MOVE.W  2*3(A0),D0
  100.         SUBQ.W  #1,D0
  101.         MOVE.W  D0,(A1)                 ; 'begin' = vINTOUT[3]
  102.         
  103.         BRA     cont
  104.         
  105. noBegEnd:
  106.         MOVE.L  -(A3),A1
  107.         CLR.W   (A1)
  108.         MOVE.L  -(A3),A1
  109.         CLR.W   (A1)
  110.         
  111. cont:   ADDQ.L  #6,A0
  112.         
  113.         MOVE.L  -(A3),A1
  114.         MOVE.W  -(A0),D0
  115.         SUBQ.W  #1,D0
  116.         MOVE.W  D0,(A1)                 ; 'mode' = intout[2]
  117.         
  118.         MOVE.L  -(A3),A1
  119.         MOVE.W  -(A0),(A1)              ; 'color' = intout[1]
  120.         
  121.         MOVE.L  -(A3),A1
  122.         MOVE.W  -(A0),D0
  123.         SUBQ.W  #1,D0
  124.         MOVE.W  D0,(A1)                 ; 'typ' = intout[0]
  125.         
  126.         SUBQ.L  #4,A3
  127.   END;
  128. END GetLineStyle;
  129.  
  130. PROCEDURE GetMarkerStyle(handle:DeviceHandle;VAR typ:MarkerType;
  131.                          VAR color:CARDINAL;VAR mode:WritingMode;
  132.                          VAR height:CARDINAL);
  133.                          
  134. BEGIN
  135.   ASSEMBLER
  136.         MOVE.L  -20(A3),(A3)+
  137.         MOVE.W  #INQUIRE_MARKER,(A3)+
  138.         CLR.W   (A3)+
  139.         JSR     vdi_if
  140.         MOVE.L  pubs,A0
  141.         MOVE.L  -(A3),A1
  142.         MOVE.W  pubArrays.PTSOUT+2(A0),(A1)
  143.         LEA     pubArrays.vINTOUT+$6(A0),A0
  144.         MOVE.L  -(A3),A1
  145.         MOVE.W  -(A0),D0
  146.         SUBQ.W  #1,D0
  147.         MOVE.W  D0,(A1)
  148.         MOVE.L  -(A3),A1
  149.         MOVE.W  -(A0),(A1)
  150.         MOVE.L  -(A3),A1
  151.         MOVE.W  -(A0),D0
  152.         ;SUBQ.W  #1,D0          unötig wegen GEM-Fehler
  153.         MOVE.W  D0,(A1)
  154.         SUBQ.L  #4,A3
  155.   END;
  156. END GetMarkerStyle;
  157.                          
  158. PROCEDURE GetFillStyle(handle:DeviceHandle;VAR typ:FillType;VAR color:CARDINAL;
  159.                        VAR index:CARDINAL;VAR mode:WritingMode;
  160.                        VAR peri:BOOLEAN);
  161.                        
  162. BEGIN
  163.   ASSEMBLER
  164.         MOVE.L  -24(A3),(A3)+
  165.         MOVE.W  #INQUIRE_FILL,(A3)+
  166.         CLR.W   (A3)+
  167.         JSR     vdi_if
  168.         MOVE.L  pubs,A0
  169.         LEA     pubArrays.vINTOUT+$A(A0),A0
  170.         MOVE.L  -(A3),A1
  171.         MOVE.W  -(A0),(A1)
  172.         MOVE.L  -(A3),A1
  173.         MOVE.W  -(A0),D0
  174.         SUBQ.W  #1,D0
  175.         MOVE.W  D0,(A1)
  176.         MOVE.L  -(A3),A1
  177.         MOVE.W  -(A0),(A1)
  178.         MOVE.L  -(A3),A1
  179.         MOVE.W  -(A0),(A1)
  180.         MOVE.L  -(A3),A1
  181.         MOVE.W  -(A0),(A1)
  182.         SUBQ.L  #4,A3
  183.   END;
  184. END GetFillStyle;
  185.                            
  186. PROCEDURE GetTextStyle(handle:DeviceHandle;VAR font,color,angle:CARDINAL;
  187.                        VAR hor:THorJust;VAR vert:TVertJust;VAR mode:WritingMode;
  188.                        VAR charW,charH,boxW,boxH:CARDINAL);
  189.                        
  190. BEGIN
  191.   ASSEMBLER
  192.         MOVE.L  -44(A3),(A3)+
  193.         MOVE.W  #INQUIRE_TEXT,(A3)+
  194.         CLR.W   (A3)+
  195.         JSR     vdi_if
  196.         MOVE.L  pubs,A0
  197.         MOVE.L  -(A3),A1
  198.         MOVE.W  pubArrays.PTSOUT+6(A0),(A1)
  199.         MOVE.L  -(A3),A1
  200.         MOVE.W  pubArrays.PTSOUT+4(A0),(A1)
  201.         MOVE.L  -(A3),A1
  202.         MOVE.W  pubArrays.PTSOUT+2(A0),(A1)
  203.         MOVE.L  -(A3),A1
  204.         MOVE.W  pubArrays.PTSOUT(A0),(A1)
  205.         LEA     pubArrays.vINTOUT+$C(A0),A0
  206.         MOVE.L  -(A3),A1
  207.         MOVE.W  -(A0),D0
  208.         ;SUBQ.W  #1,D0          unötig wegen GEM-Fehler
  209.         MOVE.W  D0,(A1)
  210.         MOVE.L  -(A3),A1
  211.         MOVE.W  -(A0),(A1)
  212.         MOVE.L  -(A3),A1
  213.         MOVE.W  -(A0),(A1)
  214.         MOVE.L  -(A3),A1
  215.         MOVE.W  -(A0),(A1)
  216.         MOVE.L  -(A3),A1
  217.         MOVE.W  -(A0),(A1)
  218.         MOVE.L  -(A3),A1
  219.         MOVE.W  -(A0),(A1)
  220.         SUBQ.L  #4,A3
  221.   END;
  222. END GetTextStyle;
  223.                        
  224. PROCEDURE TextExtent(handle:DeviceHandle;REF str:ARRAY OF CHAR):Rectangle;
  225.  
  226. BEGIN
  227.   ASSEMBLER
  228.         MOVE.L  D4,-(A7)
  229.         CLR.W   D4
  230.         JSR     stringIntoINTIN
  231.         MOVE.W  -(A3),D0
  232.         
  233.         MOVE.W  D0,-(A7)
  234.         SUBQ.L  #2,A7
  235.         MOVE.L  A7,(A3)+
  236.         JSR     setDevice
  237.         MOVE.W  (A7)+,D1
  238.         MOVE.W  (A7)+,D0
  239.         TST.W   D1
  240.         BEQ     ende
  241.         
  242.         MOVE.L  our_cb,A0
  243.         MOVE.W  #TEXT_EXTENT,cb.V_CONTRL.opcode(A0)
  244.         CLR.W   cb.V_CONTRL.sptsin(A0)
  245.         MOVE.L  cb.CURDEVICE(A0),A1     ; set current device handle
  246.         MOVE.W  device.handle(A1),cb.V_CONTRL.handle(A0)
  247.         MOVE.W  D0,cb.V_CONTRL.sintin(A0) ; strlen(in vINTIN) -> ctrl-array
  248.         MOVE.L  A0,(A3)+
  249.         JSR     vdi_call
  250.         MOVE.L  pubs,A0
  251.         LEA     pubArrays.PTSOUT(A0),A0        ; Get first two coor.pairs
  252.         MOVE.W  (A0)+,D0
  253.         MOVE.W  (A0)+,D1
  254.         MOVE.W  (A0)+,D2
  255.         MOVE.W  (A0)+,D3
  256.         CMP.W   D0,D2                   ; d0 ~ smallest x
  257.         BCC     cont3                   ; d1 ~ smallest y
  258.         EXG     D0,D2                   ; d2 ~ greatest x
  259. cont3                                   ; d3 ~ greatest y
  260.         CMP.W   D1,D3
  261.         BCC     cont4
  262.         EXG     D1,D3
  263. cont4
  264.         MOVEQ   #1,D5                   ; there are 2 points left
  265. loop2
  266.         MOVE.L  (A0)+,D4                ; get point
  267.         CMP.W   D1,D4                   ; and test y
  268.         BCC     cont5
  269.         MOVE.W  D4,D1
  270.         BRA     cont6
  271. cont5
  272.         CMP.W   D4,D3
  273.         BCC     cont6
  274.         MOVE.W  D4,D3
  275. cont6
  276.         SWAP    D4                      ; test x
  277.         CMP.W   D0,D4
  278.         BCC     cont7
  279.         MOVE.W  D4,D0
  280.         BRA     cont8
  281. cont7
  282.         CMP.W   D4,D2
  283.         BCC     cont8
  284.         MOVE.W  D4,D2
  285. cont8
  286.         DBF     D5,loop2                ; next point, if one is left
  287.         SUB.W   D0,D2
  288.         SUB.W   D1,D3
  289.         ADDQ.W  #1,D2
  290.         ADDQ.W  #1,D3
  291.         MOVE.W  D0,(A3)+                ; RETURN Rect(x,y,w,h)
  292.         MOVE.W  D1,(A3)+
  293.         MOVE.W  D2,(A3)+
  294.         MOVE.W  D3,(A3)+
  295. ende
  296.         MOVE.L  (A7)+,D4
  297.   END;
  298. END TextExtent;
  299.  
  300. PROCEDURE GetCharSize(handle:DeviceHandle;
  301.                       ch:CHAR; VAR width,dLeft,dRight:CARDINAL);
  302.  
  303. BEGIN
  304.   ASSEMBLER
  305.     MOVE.L      -(A3),-(A7)
  306.     MOVE.L      -(A3),-(A7)
  307.     MOVE.L      -(A3),-(A7)
  308.     MOVE.L      pubs,A0
  309.     MOVEQ       #0, D0
  310.     SUBQ.L      #1, A3
  311.     MOVE.B      -(A3),D0
  312.     MOVE.W      D0,pubArrays.vINTIN(A0)
  313.     MOVE.W      #INQUIRE_CELL,(A3)+
  314.     CLR.W       (A3)+
  315.     JSR         vdi_if
  316.     MOVE.L      pubs,A0
  317.     TST.W       pubArrays.vINTOUT(A0)
  318.     BPL         noError
  319.     JSR         gemErrorOccured
  320.     TST.L       (A7)+
  321.     TST.L       (A7)+
  322.     TST.L       (A7)+
  323.     BRA         cont
  324. noError
  325.     MOVE.L      (A7)+,A1
  326.     MOVE.W      pubArrays.PTSOUT(A0),(A1)
  327.     MOVE.L      (A7)+,A1
  328.     MOVE.W      pubArrays.PTSOUT+4(A0),(A1)
  329.     MOVE.L      (A7)+,A1
  330.     MOVE.W      pubArrays.PTSOUT+8(A0),(A1)
  331. cont
  332.   END;
  333. END GetCharSize;
  334.  
  335. PROCEDURE GetFaceName(handle:DeviceHandle;num:CARDINAL;VAR name:ARRAY OF CHAR);
  336.  
  337. CONST   faceNameLen     =32;    (* Länge des Fontnamens *)
  338.  
  339. BEGIN
  340.   ASSEMBLER
  341.         MOVE.W  -(A3),D0
  342.         CMP.W   #faceNameLen-2,D0
  343.         BLS     err             ; Falls HIGH(name)<=30, dann springe zu 'Fehler'
  344.         MOVE.W  D0,-(A7)
  345.         MOVE.L  -(A3),-(A7)
  346.         MOVE.L  pubs,A0
  347.         MOVE.W  -(A3),pubArrays.vINTIN(A0)
  348.         MOVE.W  #VQT_NAME,(A3)+
  349.         CLR.W   (A3)+
  350.         JSR     vdi_if
  351.         MOVE.L  pubs,A0
  352.         LEA     pubArrays.vINTOUT+2(A0),A0
  353.         MOVE.L  (A7)+,A1
  354.         MOVE.W  #faceNameLen-1,D0
  355. loop
  356.         MOVE.W  (A0)+,D1
  357.         MOVE.B  D1,(A1)+
  358.         DBF     D0,loop
  359.         MOVE.W  (A7)+,D0
  360.         CMP.W   #faceNameLen-1,D0
  361.         BEQ     ende
  362.         CLR.B   (A1)
  363.         BRA     ende
  364. err
  365.         TRAP    #noErrorTrap
  366.         DC.W    StringOverflow
  367.         SUBA.W  #10,A3
  368. ende
  369.   END;
  370. END GetFaceName;
  371.  
  372. PROCEDURE GetCellArray (handle:DeviceHandle; frame:Rectangle;
  373.                         rowLength,numRows:CARDINAL;
  374.                         VAR usedElems,usedRows:CARDINAL;
  375.                         VAR undef:BOOLEAN; VAR colArray:ARRAY OF CARDINAL);
  376. BEGIN
  377.   ASSEMBLER
  378.         JSR     HALT
  379.   END
  380. END GetCellArray;
  381.  
  382. PROCEDURE GetFaceInfo (handle:DeviceHandle; VAR minADE,maxADE:CARDINAL;
  383.                        VAR bottom,descent,half,ascent,top:CARDINAL;
  384.                        VAR maxWidth,deltaXSpecial,leftOff,rightOff:INTEGER);
  385.                        
  386. BEGIN
  387.   ASSEMBLER
  388.         MOVE.L  -48(A3),(A3)+
  389.         MOVE.W  #VQT_FONTINFO,(A3)+
  390.         CLR.W   (A3)+
  391.         JSR     vdi_if
  392.         MOVE.L  pubs,A0
  393.         MOVE.L  -(A3),A1
  394.         MOVE.W  pubArrays.PTSOUT+12(A0),(A1)
  395.         MOVE.L  -(A3),A1
  396.         MOVE.W  pubArrays.PTSOUT+8(A0),(A1)
  397.         MOVE.L  -(A3),A1
  398.         MOVE.W  pubArrays.PTSOUT+4(A0),(A1)
  399.         MOVE.L  -(A3),A1
  400.         MOVE.W  pubArrays.PTSOUT(A0),(A1)
  401.         MOVE.L  -(A3),A1
  402.         MOVE.W  pubArrays.PTSOUT+18(A0),(A1)
  403.         MOVE.L  -(A3),A1
  404.         MOVE.W  pubArrays.PTSOUT+14(A0),(A1)
  405.         MOVE.L  -(A3),A1
  406.         MOVE.W  pubArrays.PTSOUT+10(A0),(A1)
  407.         MOVE.L  -(A3),A1
  408.         MOVE.W  pubArrays.PTSOUT+6(A0),(A1)
  409.         MOVE.L  -(A3),A1
  410.         MOVE.W  pubArrays.PTSOUT+2(A0),(A1)
  411.         MOVE.L  -(A3),A1
  412.         MOVE.W  pubArrays.vINTOUT+2(A0),(A1)
  413.         MOVE.L  -(A3),A1
  414.         MOVE.W  pubArrays.vINTOUT+0(A0),(A1)
  415.         SUBQ.L  #4,A3
  416.   END;
  417. END GetFaceInfo;
  418.  
  419.  
  420. END VDIInquires.
  421. (* $FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$0000227A$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780$FFF8B780Ç$00000A11T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFECD75C$00000940$FFECD75C$0000092A$00000918$00000927$00000A7E$00000A2F$00000940$000009B1$000001CD$000002CE$0000025E$000002CB$00000A20$00000A11ÇÇâ*)
  422.